home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / lxlt113.zip / SOURCES / CHCASE.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-07  |  8KB  |  279 lines
  1. uses  os2base, miscUtil, Helpers, strOp, Crt, Dos;
  2. const Version   = '1.0.1';
  3.       Recurse   : boolean = _OFF;
  4.       Pause     : boolean = _OFF;
  5.       Verbose   : boolean = _ON;
  6.       AssumeYes : boolean = _OFF;
  7.  
  8.       cmBreak   = 0;
  9.       cmLower   = 1;
  10.       cmUpper   = 2;
  11.       cmMixed   = 3;
  12.       cmAsIs    = 4;
  13.  
  14. var   OldExit   : Procedure;
  15.       fNames    : pDarray;
  16.       allDone   : boolean;
  17.       CaseMode  : array[1..64] of Byte;
  18.       SepString : string[16];
  19.  
  20. Procedure Stop(eCode : Byte);
  21. begin
  22.  case eCode of
  23.   1,2 : begin
  24.          if eCode = 2
  25.           then begin
  26.                 TextAttr := $0C;
  27.                 Writeln('├ Invalid switch - see help below for details');
  28.                end;
  29.          TextAttr := $07;
  30.          Writeln('├ Usage: chCase [FileMask1] {...FileMask2} {/CEPSVYH?}');
  31.          Writeln('├ /C{#{.}}Convert to [L]ower/[U]pper/[M]ixed/[A]s-is case');
  32.          Writeln('├ /E{+|-} r[E]cursive (+) file search through subdirectories');
  33.          Writeln('├ /P{+|-} Enable (+) or disable (-) pause before each file');
  34.          Writeln('├ /S"{#}" Define separator character(s) OVER old ones');
  35.          Writeln('├ /V{+|-} Verbose (show a lot of additional information)');
  36.          Writeln('├ /Y{+|-} assume (+) on all queries first available responce');
  37.          Writeln('├ /?,/H   Show this help screen');
  38.          Writeln('├┤Default: /CL /E- /P- /S"." /V+ /Y-');
  39.          TextAttr := $08;
  40.          Writeln('└┤Example: chCase /cm d:\*.*.txt /e /v-');
  41.         end;
  42.  end;
  43.  Halt(eCode);
  44. end;
  45.  
  46. Function ParmHandler(var S : string) : Byte;
  47. var I : Longint;
  48.  
  49. Function Enabled : boolean;
  50. begin
  51.  Enabled := _ON;
  52.  if length(S) = 1
  53.   then exit
  54.   else
  55.  if (S[2] in ['+','-'])
  56.   then ParmHandler := 2
  57.   else
  58.  if (S[2] in [' ','/'])
  59.   then exit
  60.   else Stop(2);
  61.  if S[2] = '-' then Enabled := _OFF;
  62. end;
  63.  
  64. begin
  65.  ParmHandler := 1;
  66.  case upCase(S[1]) of
  67.   '?',
  68.   'H' : Stop(1);
  69.   'C' : begin
  70.          I := 1;
  71.          repeat
  72.           case upCase(S[succ(I)]) of
  73.            'L' : CaseMode[I] := cmLower;
  74.            'U' : CaseMode[I] := cmUpper;
  75.            'M' : CaseMode[I] := cmMixed;
  76.            'A' : CaseMode[I] := cmAsIs;
  77.            else break;
  78.           end;
  79.           Inc(I);
  80.          until (I >= 64) or (I >= length(S));
  81.          CaseMode[I] := cmBreak;
  82.          ParmHandler := I;
  83.         end;
  84.   'E' : Recurse := Enabled;
  85.   'P' : Pause := Enabled;
  86.   'V' : Verbose := Enabled;
  87.   'Y' : AssumeYes := Enabled;
  88.   'S' : begin
  89.          if (length(S) < 2) or (S[2] <> '"') then Stop(2);
  90.          I := 3; SepString := '';
  91.          While (I <= length(S)) do
  92.           begin
  93.            if S[I] = '"' then break;
  94.            if First(S[I], SepString) = 0
  95.             then SepString := SepString + S[I];
  96.            Inc(I);
  97.           end;
  98.          if S[I] <> '"' then Stop(2);
  99.          ParmHandler := I;
  100.         end;
  101.   else Stop(2);
  102.  end;
  103. end;
  104.  
  105. Function NameHandler(var S : string) : Byte;
  106. var I     : Longint;
  107.     Quote : boolean;
  108. begin
  109.  I := 0;
  110.  if S[1] = '"' then begin Quote := _ON; Delete(S, 1, 1); end else Quote := _OFF;
  111.  While (I < length(S)) and ((S[succ(I)] > ' ') or Quote) do
  112.   if Quote and (S[succ(I)] = '"')
  113.    then break
  114.    else Inc(I);
  115.  fNames^.AddItem(NewStr(Copy(S, 1, I)));
  116.  Inc(I, byte(Quote));
  117.  NameHandler := I;
  118. end;
  119.  
  120. Procedure MyExitProc;
  121. begin
  122.  Write(#13);
  123.  TextAttr := $07; ClrEOL;
  124.  OldExit;
  125. end;
  126.  
  127. Function Ask(const Q,A : string) : byte;
  128. var ch  : char;
  129. begin
  130.  if AssumeYes then begin Ask := 1; exit; end;
  131.  TextAttr := $02;
  132.  Write('└ ', Q, ' ');
  133.  repeat
  134.   ch := upCase(ReadKey);
  135.   if First(ch, A) <> 0
  136.    then begin
  137.          Ask := First(ch, A);
  138.          break;
  139.         end;
  140.  until _OFF;
  141.  Writeln(Ch,#13'├');
  142. end;
  143.  
  144. {Returns: 0 - file is not locked for write}
  145. {         1 - file is locked and cannot be unlocked}
  146. {         2 - file has been unlocked}
  147. Function CheckUseCount(fName : string) : byte;
  148. var F : File;
  149.     I : Longint;
  150. begin
  151.  CheckUseCount := 0;
  152.  I := FileMode; FileMode := open_access_ReadWrite or open_share_DenyReadWrite;
  153.  Assign(F, fName); SetFattr(F, Archive);
  154.  Reset(F, 1); Close(F); FileMode := I;
  155.  if ioResult = 0 then exit;
  156.  textAttr := $0E;
  157.  Writeln(#13'├ The module ' + Copy(fName, 1, 40) + ' is used by another process');
  158.  CheckUseCount := 1;
  159.  case Ask('[R]eplace, [S]kip or [A]bort?', 'RSA') of
  160.   1 : ;
  161.   2 : exit;
  162.   3 : begin allDone := _ON; exit; end;
  163.  end;
  164.  fName := fName + #0;
  165.  if DosReplaceModule(@fName[1], nil, nil) <> 0
  166.   then begin
  167.         textAttr := $0C;
  168.         Writeln('├ Cannot replace module ' + fName);
  169.         exit;
  170.        end;
  171.  CheckUseCount := 2;
  172. end;
  173.  
  174. Procedure ProcessFile(fName : string; Attr : Word);
  175. var   _d    : DirStr;
  176.       _n    : NameStr;
  177.       _e    : ExtStr;
  178.       dfn   : String;
  179.       I,cmp : Longint;
  180. begin
  181.  fSplit(fName, _d, _n, _e);
  182.  _n := _n + _e;
  183.  I := 1; cmp := 1; dfn := '';
  184.  While I <= length(_n) do
  185.   begin
  186.    _e := '';
  187.    While (i <= length(_n)) and (First(_n[i], SepString) = 0) do
  188.     begin _e := _e + _n[i]; Inc(i); end;
  189.    case CaseMode[cmp] of
  190.     cmLower : lowStr(_e);
  191.     cmUpper : upStr(_e);
  192.     cmMixed : begin lowStr(_e); _e[1] := upCase(_e[1]); end;
  193.    end;
  194.    if (CaseMode[cmp] <> cmBreak) and (CaseMode[succ(cmp)] <> cmBreak)
  195.     then Inc(cmp);
  196.    dfn := dfn + _e;
  197.    if i <= length(_n) then begin dfn := dfn + _n[i]; Inc(i); end;
  198.   end;
  199.  if (Attr and Directory = 0) and (CheckUseCount(fName) = 1) then exit;
  200.  textAttr := $0B; ClrEOL; Write('└ ', Copy(_n, 1, 32), ' -> ', Copy(dfn, 1, 32));
  201.  if FileRename(_d + _n, _d + dfn)
  202.   then if Verbose
  203.         then begin
  204.               textAttr := $0A; Write(' ok'#13);
  205.               textAttr := $0B; Writeln('├');
  206.              end
  207.         else begin Write(#13); ClrEOL; end
  208.   else begin
  209.         textAttr := $0C; Write(' error'#13);
  210.         textAttr := $0B; Writeln('├');
  211.        end;
  212. end;
  213.  
  214. Procedure ProcessFiles(const fN : string; Level : Longint);
  215. var sr : SearchRec;
  216.     _d : DirStr;
  217.     _n : NameStr;
  218.     _e : ExtStr;
  219.     nf : Longint;
  220. begin
  221.  fSplit(fN, _d, _n, _e);
  222.  FindFirst(fN, Archive or Hidden or SysFile or Directory, sr);
  223.  if (DosError <> 0) and (Level = 0) and (not Recurse)
  224.   then begin
  225.         textAttr := $0C;
  226.         Writeln('├ Cannot find such files: ', fN);
  227.        end;
  228.  nf := 0;
  229.  While (DosError = 0) and (not allDone) do
  230.   begin
  231.    if (sr.Name <> '.') and (sr.Name <> '..')
  232.     then begin
  233.           if Pause
  234.            then case Ask('File ' + sr.Name + ': [P]rocess, [S]kip or [A]bort?', 'PSA') of
  235.                  2 : sr.Name := '';
  236.                  3 : begin allDone := _ON; break; end;
  237.                 end;
  238.           if (sr.Name <> '') then ProcessFile(_d + sr.Name, sr.Attr);
  239.          end;
  240.    FindNext(sr);
  241.   end;
  242.  FindClose(sr);
  243.  if allDone or not Recurse then Exit;
  244.  if nf = 0 then begin textAttr := $0B; Write('└ ', _d); ClrEOL; Write(#13); end;
  245.  FindFirst(_d + '*.*', Archive or Hidden or SysFile or Directory, sr);
  246.  While (dosError = 0) and (not allDone) do
  247.   begin
  248.    if (sr.Attr and Directory <> 0) and (sr.Name[1] <> '.')
  249.     then ProcessFiles(_d + sr.Name + '\' + _n + _e, succ(Level));
  250.    FindNext(sr);
  251.   end;
  252.  FindClose(sr);
  253. end;
  254.  
  255. var I : Longint;
  256.  
  257. begin
  258.  TextAttr := $0F;
  259.  Writeln('┌[ chCase ]──────────────────────────────[ Version '+Version+' ]┐');
  260.  Writeln('├ Copyright 1996 by FRIENDS software ─ No rights reserved ┘');
  261.  TextAttr := $07;
  262.  @OldExit := ExitProc; ExitProc := @MyExitProc;
  263.  New(fNames, Init(8));
  264.  CaseMode[1] := cmLower;
  265.  SepString := '.';
  266.  ParseCommandLine(#1, ParmHandler, NameHandler);
  267.  if (fNames^.numItems = 0) then Stop(1);
  268.  
  269.  For I := 1 to fNames^.numItems do
  270.   begin
  271.    ProcessFiles(pString(fNames^.GetItem(I))^, 0);
  272.    if allDone then break;
  273.   end;
  274.  
  275.  TextAttr := $01; ClrEOL;
  276.  Writeln('└┤Done');
  277. end.
  278.  
  279.